home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr06 / mnhlp101.zip / MINEHELP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  20KB  |  634 lines
  1. PROGRAM MineHelp;
  2.  
  3.   {Version 1.00: April 26, 1992.
  4.    Version 1.01: May 8, 1993.
  5.    Peter Karrer (pkarrer@bernina.ethz.ch / 100121,2215)}
  6.  
  7.   {$M 40960,8192}
  8.   {$G+}
  9.  
  10.   USES WObjects, WinTypes, WinProcs, Strings;
  11.  
  12.   {$R MINEHELP.RES}
  13.  
  14.   CONST
  15.     appName = 'MineHelp';
  16.     {Child control IDs}
  17.     inactive = 103;
  18.     active = 104;
  19.     automatic = 105;
  20.     basic = 106;
  21.     expert = 107;
  22.     rand = 108;
  23.     id_Animation = 110;
  24.     id_OK = 109;
  25.  
  26.     white = $ffffff;
  27.     {colors masked with $ffc0c0c0}
  28.     blue  = $c00000;
  29.     dblue = $800000;
  30.     red   = $0000c0;
  31.     dred  = $000080;
  32.     dgreen= $008000;
  33.     dcyan = $808000;
  34.     black = 0;
  35.     dgray = $808080;
  36.     gray  = $c0c0c0;
  37.     xOff = -4; { width of left border in Minesweeper window client area - 16}
  38.     yOff = 39; { width of top  border in Minesweeper window client area - 16}
  39.  
  40.   TYPE
  41.  
  42.     TThisApp = OBJECT(TApplication)
  43.       PROCEDURE InitMainWindow; VIRTUAL;
  44.     END;
  45.  
  46.     PThisWindow = ^TThisWindow;
  47.     TThisWindow = OBJECT(TDlgWindow)
  48.       stat: INTEGER; {id of checked "Status" button}
  49.       lev: INTEGER;  {id of checked "Level" button}
  50.       animation: BOOLEAN;
  51.       msWin: HWnd;
  52.       mswX, mswY: INTEGER;
  53.       dimX, dimY: INTEGER;
  54.       busy: BOOLEAN;
  55.       CONSTRUCTOR Init;
  56.       FUNCTION  GetClassName: PCHAR; VIRTUAL;
  57.       PROCEDURE GetWindowClass(VAR c: TWndClass); VIRTUAL;
  58.       PROCEDURE SetupWindow; VIRTUAL;
  59.       PROCEDURE DefChildProc(VAR msg: TMessage); VIRTUAL;
  60.       PROCEDURE WMDestroy(VAR msg: TMessage); VIRTUAL wm_first + wm_Destroy;
  61.       PROCEDURE WMTimer(VAR msg: TMessage); VIRTUAL wm_first + wm_Timer;
  62.       PROCEDURE DoIt;
  63.       FUNCTION  GetMsWin: HWnd;
  64.       PROCEDURE GetBoard(VAR bomb: BOOLEAN);
  65.       PROCEDURE Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  66.       PROCEDURE Mark(x, y: INTEGER);
  67.       PROCEDURE ClearFields(VAR somethingDone: BOOLEAN);
  68.       PROCEDURE MarkFields(VAR somethingDone: BOOLEAN);
  69.       FUNCTION  TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  70.       PROCEDURE TwoFields(VAR success: BOOLEAN);
  71.       PROCEDURE ClearRandom(VAR somethingHappened: BOOLEAN);
  72.     END;
  73.  
  74.   VAR
  75.     thisApp: TThisApp;
  76.     bb: ARRAY [0..25, 0..31] OF INTEGER;
  77.     ee: ARRAY [0..25, 0..31] OF INTEGER;
  78.  
  79.   CONSTRUCTOR TThisWindow.Init;
  80.   BEGIN
  81.     TDlgWindow.Init(NIL, appName);
  82.   END;
  83.  
  84.   FUNCTION TThisWindow.GetClassName: PCHAR;
  85.   BEGIN
  86.     GetClassName := appName;
  87.   END;
  88.  
  89.   PROCEDURE TThisWindow.GetWindowClass(VAR c: TWndClass);
  90.   BEGIN
  91.     TDlgWindow.GetWindowClass(c);
  92.     {c.hIcon := LoadIcon(hInstance, appName); doesn't work?!}
  93.   END;
  94.  
  95.   PROCEDURE TThisWindow.SetupWindow;
  96.     VAR
  97.       i: INTEGER;
  98.   BEGIN
  99.     TDlgWindow.SetupWindow;
  100.     IF SetTimer(hWindow, 1, 1000, NIL) = 0 THEN BEGIN
  101.       MessageBox(HWindow, 'Sorry, no timers', NIL, mb_Ok);
  102.       Destroy;
  103.     END;
  104.     {Setting the icon didn't work in GetWindowClass, dunno why}
  105.     SetClassWord(hWindow, GCW_HICON, LoadIcon(hInstance, appName));
  106.     animation := POS('n', ParamStr(1)) <> 0;
  107.     IF POS('h', ParamStr(1)) <> 0 THEN BEGIN
  108.       cmdShow := sw_Hide;
  109.     END ELSE IF POS('c', ParamStr(1)) <> 0 THEN BEGIN
  110.       cmdShow := sw_Minimize;
  111.     END;
  112.     IF POS('a', ParamStr(1)) <> 0 THEN BEGIN
  113.       stat := active;
  114.     END ELSE IF POS('i', ParamStr(1)) <> 0 THEN BEGIN
  115.       stat := inactive;
  116.     END ELSE BEGIN
  117.       stat := automatic;
  118.     END;
  119.     IF POS('b', ParamStr(1)) <> 0 THEN BEGIN
  120.       lev := basic;
  121.     END ELSE IF POS('r', ParamStr(1)) <> 0 THEN BEGIN
  122.       lev := rand;
  123.     END ELSE BEGIN
  124.       lev := expert;
  125.     END;
  126.     SendDlgItemMsg(stat, bm_SetCheck, 1, 0);
  127.     SendDlgItemMsg(lev, bm_SetCheck, 1, 0);
  128.     SendDlgItemMsg(id_animation, bm_SetCheck, ORD(animation), 0);
  129.     RANDOMIZE;
  130.     busy := FALSE;
  131.   END;
  132.  
  133.   PROCEDURE WaitIdle;
  134.     {It's impolite to hog the CPU}
  135.     VAR
  136.       m: TMsg;
  137.   BEGIN
  138.     WHILE PeekMessage(m, 0, 0, 0, pm_Remove) DO BEGIN
  139.       IF m.message = wm_Quit THEN BEGIN
  140.         HALT(m.wParam);
  141.       END;
  142.       TranslateMessage(m);
  143.       DispatchMessage(m);
  144.     END;
  145.   END;
  146.  
  147.   PROCEDURE TThisWindow.Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  148.   BEGIN
  149.     IF animation THEN BEGIN
  150.       SetCursorPos(mswX + xOff + 16*x + 8, mswY + yOff + 16*y + 8);
  151.     END;
  152.     SendMessage(msWin, btnDown, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  153.     SendMessage(msWin, btnUp, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  154.   END; {Click}
  155.  
  156.   PROCEDURE TThisWindow.GetBoard(VAR bomb: BOOLEAN);
  157.     {Examine the Minesweeper window client area. Get the contents of the
  158.      individual squares by reading pixels at strategic locations. Colors
  159.      are masked with $FFC0C0C0, because not all display drivers use the same
  160.      intensities for colors like dark cyan or dark red}
  161.     VAR
  162.       x, y, v: INTEGER;
  163.       rgb: LONGINT;
  164.       msDC: HDC;
  165.   BEGIN
  166.     bomb := FALSE;
  167.     msDC := GetDC(msWin);
  168.     FOR y := 1 TO dimY DO BEGIN
  169.       FOR x := 1 TO dimX DO BEGIN
  170.         rgb := GetPixel(msDC, xOff + 9 + 16*x, yOff + 12 + 16*y) AND $ffc0c0c0;
  171.         IF rgb = blue THEN BEGIN
  172.           bb[y, x] := 1;
  173.         END ELSE IF rgb = dgreen THEN BEGIN
  174.           bb[y, x] := 2;
  175.         END ELSE IF rgb = red THEN BEGIN
  176.           bb[y, x] := 3;
  177.         END ELSE IF rgb = dblue THEN BEGIN
  178.           bb[y, x] := 4;
  179.         END ELSE IF rgb = dred THEN BEGIN
  180.           bb[y, x] := 5;
  181.         END ELSE IF rgb = dcyan THEN BEGIN
  182.           bb[y, x] := 6;
  183.         END ELSE IF rgb = black THEN BEGIN
  184.           rgb := GetPixel(msDC, xOff + 7 + 16*x, yOff + 6 + 16*y);
  185.           IF rgb = white THEN BEGIN
  186.             bb[y, x] := -2; bomb := TRUE; {mine}
  187.           END ELSE BEGIN
  188.             rgb := rgb AND $ffc0c0c0;
  189.             IF rgb = gray THEN BEGIN
  190.               bb[y, x] := 7;
  191.             END ELSE IF rgb = red THEN BEGIN
  192.               bb[y, x] := 128; {flag}
  193.             END ELSE IF rgb = black THEN BEGIN
  194.               bb[y, x] := 2049; {question mark}
  195.             END ELSE BEGIN
  196.               bb[y, x] := -999; bomb := TRUE; {invisible}
  197.             END;
  198.           END;
  199.         END ELSE IF rgb = dgray THEN BEGIN
  200.           bb[y, x] := 8;
  201.         END ELSE IF rgb = gray THEN BEGIN
  202.           rgb := GetPixel(msDC, xOff + 15 + 16*x, yOff + 1 +16*y) AND $ffc0c0c0;
  203.           IF rgb = gray THEN BEGIN
  204.             bb[y, x] := 0;
  205.           END ELSE IF rgb = dgray THEN BEGIN
  206.             rgb := GetPixel(msDC, xOff + 5 + 16*x, yOff + 5 +16*y) AND $ffc0c0c0;
  207.             IF rgb = black THEN BEGIN
  208.               bb[y,x] := 2049; {question mark}
  209.             END ELSE IF rgb = gray THEN BEGIN
  210.               bb[y, x] := 2048; {covered}
  211.             END ELSE BEGIN
  212.               bb[y, x] := -999; bomb := TRUE;
  213.             END;
  214.           END ELSE BEGIN
  215.             bb[y, x] := -999; bomb := TRUE; {invisible}
  216.           END;
  217.         END ELSE BEGIN
  218.           bb[y, x] := -999; bomb := TRUE; {invisible}
  219.         END;
  220.       END; {FOR x}
  221.     END; {FOR y}
  222.     ReleaseDC(msWin, msDC);
  223.     IF NOT bomb THEN BEGIN
  224.       FOR y := 1 TO dimY DO BEGIN
  225.         FOR x := 1 TO dimX DO BEGIN
  226.           v := bb[y, x];
  227.           IF (v > 0) AND (v <= 8) THEN BEGIN
  228.             ee[y, x] := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  229.                         bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  230.           END ELSE BEGIN
  231.             ee[y, x] := 0;
  232.           END;
  233.         END; {FOR x}
  234.       END; {FOR y}
  235.     END; {NOT bomb}
  236.   END; {GetBoard}
  237.  
  238.   FUNCTION TThisWindow.GetMsWin: HWnd;
  239.     {Find the Minesweeper window and its location on the screen}
  240.     VAR
  241.       w, mW: HWnd;
  242.       st: ARRAY[0..32] OF CHAR;
  243.       rp: RECORD
  244.             CASE INTEGER OF 1: (r: TRect);
  245.                             2: (p: TPoint);
  246.           END;
  247.       i: INTEGER;
  248.   BEGIN
  249.     w := 0;
  250.     mW := 0;
  251.     w := GetWindow(hWindow, gw_HWndFirst);
  252.     WHILE (w <> 0) AND (mW = 0) DO BEGIN
  253.       GetWindowText(w, st, 32);
  254.       IF StrComp(st, 'Minesweeper') = 0 THEN BEGIN
  255.         mW := w;
  256.         GetClientRect(mW, rp.r);
  257.         dimX := (rp.r.right - 24) DIV 16;
  258.         dimY := (rp.r.bottom - 67) DIV 16;
  259.         ClientToScreen(mW, rp.p);
  260.         mswX := rp.p.x;
  261.         mswY := rp.p.y;
  262.       END;
  263.       w := GetNextWindow(w, gw_HWndNext);
  264.     END;
  265.     IF mW <> 0 THEN BEGIN
  266.       FOR i := 0 TO dimX + 1 DO BEGIN
  267.         bb[0, i] := 0;
  268.         ee[0, i] := 0;
  269.         bb[dimY + 1, i] := 0;
  270.         ee[dimY + 1, i] := 0;
  271.       END;
  272.       FOR i:= 1 TO dimY DO BEGIN
  273.         bb[i, 0] := 0;
  274.         ee[i, 0] := 0;
  275.         bb[i, dimX + 1] := 0;
  276.         ee[i, dimX + 1] := 0;
  277.       END;
  278.     END;
  279.     GetMsWin := mW;
  280.   END; {GetMsWin}
  281.  
  282.   PROCEDURE TThisWindow.ClearFields(VAR somethingDone: BOOLEAN);
  283.     VAR
  284.       x, y, v, c: INTEGER;
  285.   BEGIN
  286.     somethingDone := FALSE;
  287.     FOR y := 1 TO dimY DO BEGIN
  288.       FOR x := 1 TO dimX DO BEGIN
  289.         v := bb[y, x];
  290.         IF (v > 0) AND (v <= 8) THEN BEGIN
  291.           c := ee[y, x];
  292.           IF c >= 2048 THEN BEGIN {at least 1 covered field}
  293.             c := c AND 2047 SHR 7; {number of flagged fields}
  294.             IF v = c THEN BEGIN
  295.               Click(x, y, wm_LButtonDown, wm_LButtonUp, mk_RButton);
  296.               somethingDone := TRUE;
  297.               IF stat <> automatic THEN BEGIN
  298.                 EXIT;
  299.               END;
  300.             END;
  301.           END;
  302.         END; {IF (v > 0) ..}
  303.       END; {FOR x}
  304.     END; {FOR y}
  305.   END; {ClearFields}
  306.  
  307.   PROCEDURE TThisWindow.Mark(x, y: INTEGER);
  308.   BEGIN
  309.     Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  310.     IF bb[y, x] = 2049 THEN BEGIN {question mark}
  311.       Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  312.     END;
  313.     bb[y, x] := 128; {make it flagged}
  314.   END; {Mark}
  315.  
  316.   PROCEDURE TThisWindow.MarkFields(VAR somethingDone: BOOLEAN);
  317.     VAR
  318.       x, y, v, c, f: INTEGER;
  319.   BEGIN
  320.     somethingDone := FALSE;
  321.     FOR y := 1 TO dimY DO BEGIN
  322.       FOR x := 1 TO dimX DO BEGIN
  323.         v := bb[y, x];
  324.         IF (v > 0) AND (v <= 8) THEN BEGIN
  325.           c := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  326.                bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  327.           f := c SHR 11; {number of covered fields}
  328.           IF f <> 0 THEN BEGIN
  329.             c := c AND 2047 SHR 7; {number of flagged fields}
  330.             IF (f + c) = v THEN BEGIN
  331.               IF bb[y-1,x-1] >= 2048 THEN BEGIN Mark(x-1,y-1); END;
  332.               IF bb[y-1,x  ] >= 2048 THEN BEGIN Mark(x,  y-1); END;
  333.               IF bb[y-1,x+1] >= 2048 THEN BEGIN Mark(x+1,y-1); END;
  334.               IF bb[y,  x-1] >= 2048 THEN BEGIN Mark(x-1,y  ); END;
  335.               IF bb[y,  x+1] >= 2048 THEN BEGIN Mark(x+1,y  ); END;
  336.               IF bb[y+1,x-1] >= 2048 THEN BEGIN Mark(x-1,y+1); END;
  337.               IF bb[y+1,x  ] >= 2048 THEN BEGIN Mark(x,  y+1); END;
  338.               IF bb[y+1,x+1] >= 2048 THEN BEGIN Mark(x+1,y+1); END;
  339.               somethingDone := TRUE;
  340.               IF stat <> automatic THEN BEGIN
  341.                 EXIT;
  342.               END;
  343.             END;
  344.           END;
  345.         END; {IF (v > 0) ..}
  346.       END; {FOR x}
  347.     END; {FOR y}
  348.   END; {MarkFields}
  349.  
  350.   FUNCTION TThisWindow.TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  351.     VAR
  352.       a, b, c, x, y, na, nb: INTEGER;
  353.  
  354.     PROCEDURE ClickFields(xx1, yy1, xx2, yy2: INTEGER; marks: BOOLEAN);
  355.       {Click on covered fields in environment of (x1,y1) but not of (x2,y2)}
  356.       VAR
  357.         xx, yy, dbg: INTEGER;
  358.     BEGIN
  359.       FOR yy := yy1 - 1 TO yy1 + 1 DO BEGIN
  360.         FOR xx := xx1 - 1 TO xx1 + 1 DO BEGIN
  361.           IF ((ABS(yy-yy2) > 1) OR (ABS(xx-xx2) > 1)) AND (bb[yy,xx] >= 2048) THEN BEGIN
  362.             IF marks THEN BEGIN
  363.               Mark(xx, yy);
  364.             END ELSE BEGIN
  365.               Click(xx, yy, wm_LButtonDown, wm_LButtonUp, 0);
  366.               bb[yy, xx] := 0; {meaning uncovered with unknown value}
  367.             END;
  368.           END;
  369.         END; {FOR xx}
  370.       END; {FOR yy}
  371.       TwoFieldSearch := TRUE;
  372.     END; {ClickFields}
  373.  
  374.   BEGIN {TwoFieldSearch}
  375.     TwoFieldSearch := FALSE;
  376.     c := ee[y1, x1];
  377.     x := bb[y1, x1] - c AND 2047 SHR 7; {Number of unknown mines around A=(x1,y1)}
  378.     a := c SHR 11; {Number of covered fields around A=(x1,y1)}
  379.     c := ee[y2, x2];
  380.     y := bb[y2, x2] - c AND 2047 SHR 7; {Number of unknown mines around B=(x2,y2)}
  381.     b := c SHR 11; {Number of covered fields around B=(x2,y2)}
  382.     c := 0;
  383.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1+1,x1] >= 2048) THEN c := c + 1;
  384.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1+1,x1+1]>=2048) THEN c := c + 1;
  385.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1+1,x1-1]>=2048) THEN c := c + 1;
  386.     IF (ABS(y1-y2) <= 1) AND (ABS(x1+1-x2)<= 1) AND (bb[y1,x1+1] >= 2048) THEN c := c + 1;
  387.     IF (ABS(y1-y2) <= 1) AND (ABS(x1-1-x2)<= 1) AND (bb[y1,x1-1] >= 2048) THEN c := c + 1;
  388.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1-1,x1] >= 2048) THEN c := c + 1;
  389.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1-1,x1+1]>=2048) THEN c := c + 1;
  390.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1-1,x1-1]>=2048) THEN c := c + 1;
  391.     {c = number of covered fields common to the environments of A and B}
  392.     IF c < 2 THEN BEGIN {v1.01}
  393.       EXIT;             {v1.01}
  394.     END;                {v1.01}
  395.     a := a - c;
  396.     b := b - c;
  397.     na := -1;
  398.     nb := -1;
  399.     IF a = 0 THEN BEGIN
  400.       na := 0;
  401.     END ELSE IF x + b = y THEN BEGIN
  402.       na := 0;
  403.     END ELSE IF x - a = y THEN BEGIN
  404.       na := a;
  405.     END ELSE IF b = 0 THEN BEGIN
  406.       na := x - y;
  407.     END;
  408.     IF na >= 0 THEN BEGIN
  409.       nb := y - x + na;
  410.     END ELSE IF b = 0 THEN BEGIN
  411.       nb := 0;
  412.     END ELSE IF y - b = x THEN BEGIN
  413.       nb := b;
  414.     END ELSE IF a = 0 THEN BEGIN
  415.       nb := y - x;
  416.     END;
  417.     IF nb >= 0 THEN BEGIN
  418.       na := x - y + nb;
  419.     END;
  420.     IF a <> 0 THEN BEGIN
  421.       IF na = 0 THEN BEGIN
  422.         {Clear all fields in env A but not env B}
  423.         ClickFields(x1, y1, x2, y2, FALSE);
  424.       END ELSE IF na = a THEN BEGIN
  425.         {Mark all those fields}
  426.         ClickFields(x1, y1, x2, y2, TRUE);
  427.       END;
  428.     END;
  429.     IF b <> 0 THEN BEGIN
  430.       IF (nb = 0) AND (b <> 0) THEN BEGIN
  431.         {Clear all fields in env B but not env A}
  432.         ClickFields(x2, y2, x1, y1, FALSE);
  433.       END ELSE IF nb = b THEN BEGIN
  434.         {Mark all those fields}
  435.         ClickFields(x2, y2, x1, y1, TRUE);
  436.       END;
  437.     END;
  438.   END; {TwoFieldSearch}
  439.  
  440.   PROCEDURE TThisWindow.TwoFields(VAR success: BOOLEAN);
  441.  
  442.     PROCEDURE S(x1, y1: INTEGER);
  443.       VAR
  444.         x, y, miny, maxy: INTEGER;
  445.     BEGIN
  446.       IF success AND (stat <> automatic) THEN BEGIN
  447.         EXIT;
  448.       END;
  449.       IF y1 >= 0 THEN BEGIN
  450.         miny := 1;
  451.         maxy := dimY - y1;
  452.       END ELSE BEGIN
  453.         miny := 1 - y1;
  454.         maxy := dimY;
  455.       END;
  456.       FOR y := miny TO maxy DO BEGIN
  457.         FOR x := 1 TO dimX - x1 DO BEGIN
  458.           IF (ee[y, x] >= 2048) AND (ee[y + y1, x + x1] >= 2048) THEN BEGIN
  459.             success := success OR TwoFieldSearch(x, y, x + x1, y + y1);
  460.             IF success AND (stat <> automatic) THEN BEGIN
  461.               EXIT;
  462.             END;
  463.           END;
  464.         END;
  465.       END;
  466.     END; {S}
  467.  
  468.   BEGIN {TwoFields}
  469.     success := FALSE;
  470.     S(1, 0); S(0, -1); S(1, 1); S(1, -1); S(2, -1); S(2, 1);
  471.     S(1, -2); S(1, 2); S(2, 0); S(0, -2); {S(2, -2); S(2, 2); v1.01}
  472.   END; {TwoFields}
  473.  
  474.   PROCEDURE TThisWindow.ClearRandom(VAR somethingHappened: BOOLEAN);
  475.     VAR
  476.       x, y, c, i: INTEGER;
  477.       bomb: BOOLEAN;
  478.   BEGIN
  479.     GetBoard(bomb);
  480.     somethingHappened := FALSE;
  481.     IF NOT bomb THEN BEGIN
  482.       c := 0;
  483.       FOR y := 1 TO dimY DO BEGIN
  484.         FOR x:= 1 TO dimX DO BEGIN
  485.           IF bb[y, x] >= 2048 THEN BEGIN
  486.             c := c + 1;
  487.           END;
  488.         END;
  489.       END;
  490.       IF c <> 0 THEN BEGIN
  491.         i := RANDOM(c);
  492.         c := 0;
  493.         FOR y := 1 TO dimY DO BEGIN
  494.           FOR x := 1 TO dimX DO BEGIN
  495.             IF bb[y, x] >= 2048 THEN BEGIN
  496.               IF c = i THEN BEGIN
  497.                 Click(x, y, wm_LButtonDown, wm_LButtonUp, 0);
  498.                 somethingHappened := TRUE;
  499.                 EXIT;
  500.               END;
  501.               c := c + 1;
  502.             END;
  503.           END; {FOR x}
  504.         END; {FOR y}
  505.       END; {c <> 0}
  506.     END; {NOT bomb}
  507.   END; {ClearRandom}
  508.  
  509.   PROCEDURE TThisWindow.DefChildProc(VAR msg: TMessage);
  510.     VAR
  511.       i: INTEGER;
  512.   BEGIN
  513.     WITH msg DO BEGIN
  514.       IF (lParamLo <> 0) AND (lParamHi <> 1) THEN BEGIN
  515.         { not menu, not accelerator id }
  516.         IF wParam = inactive THEN BEGIN
  517.           stat := inactive;
  518.         END ELSE IF wParam = active THEN BEGIN
  519.           stat := active;
  520.         END ELSE IF wParam = automatic THEN BEGIN
  521.           stat := automatic;
  522.         END ELSE IF wParam = basic THEN BEGIN
  523.           lev := basic;
  524.         END ELSE IF wParam = expert THEN BEGIN
  525.           lev := expert;
  526.         END ELSE IF wParam = rand THEN BEGIN
  527.           lev := rand;
  528.         END ELSE IF wParam = id_Animation THEN BEGIN
  529.           animation := NOT animation;
  530.           SendDlgItemMsg(id_Animation, bm_SetCheck, ORD(animation), 0);
  531.         END ELSE IF wParam = id_OK THEN BEGIN
  532.           IF stat = active THEN BEGIN
  533.             DoIt;
  534.           END;
  535.         END;
  536.       END; {IF (lParamLo ..}
  537.     END; {WITH msg}
  538.     TDlgWindow.DefChildProc(msg);
  539.   END;
  540.  
  541.   PROCEDURE TThisWindow.DoIt;
  542.     VAR
  543.       bomb, somethingHappened, action: BOOLEAN;
  544.       x, y: INTEGER;
  545.       m: TMsg;
  546.   BEGIN
  547.     IF busy THEN BEGIN
  548.       {avoid reentrancy}
  549.       EXIT;
  550.     END;
  551.     busy := TRUE;
  552.     msWin := GetMsWin;
  553.     IF msWin <> 0 THEN BEGIN
  554.      REPEAT
  555.       REPEAT
  556.         GetBoard(bomb);
  557.         action := FALSE;
  558.         somethingHappened := TRUE;
  559.         WHILE NOT bomb AND somethingHappened DO BEGIN
  560.           MarkFields(somethingHappened);
  561.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  562.             busy := FALSE;
  563.             EXIT;
  564.           END;
  565.           WaitIdle;
  566.           action := action OR somethingHappened;
  567.           {GetBoard(msWin, bomb);}
  568.         END;
  569.         somethingHappened := TRUE;
  570.         WHILE NOT bomb AND somethingHappened DO BEGIN
  571.           ClearFields(somethingHappened);
  572.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  573.             busy := FALSE;
  574.             EXIT;
  575.           END;
  576.           WaitIdle;
  577.           action := action OR somethingHappened;
  578.           GetBoard(bomb);
  579.         END;
  580.         {action = there were changes in mark and clear phases}
  581.       UNTIL NOT action OR bomb;
  582.       somethingHappened := lev > basic;
  583.       WHILE NOT bomb AND somethingHappened DO BEGIN
  584.         TwoFields(somethingHappened);
  585.         IF somethingHappened AND (stat <> automatic) THEN BEGIN
  586.           busy := FALSE;
  587.           EXIT;
  588.         END;
  589.         WaitIdle;
  590.         action := action OR somethingHappened;
  591.         GetBoard(bomb);
  592.       END;
  593.       IF (lev = rand) AND NOT action THEN BEGIN
  594.         ClearRandom(action);
  595.         IF stat <> automatic THEN BEGIN
  596.           busy := FALSE;
  597.           EXIT;
  598.         END;
  599.       END;
  600.      UNTIL NOT action OR bomb;
  601.     END; {msWin <> 0}
  602.     busy := FALSE;
  603.   END; {DoIt}
  604.  
  605.   PROCEDURE TThisWindow.WMTimer(VAR msg: TMessage);
  606.   BEGIN
  607.     IF stat = automatic THEN BEGIN
  608.       DoIt;
  609.     END;
  610.   END;
  611.  
  612.   PROCEDURE TThisWindow.WMDestroy(VAR msg: TMessage);
  613.   BEGIN
  614.     KillTimer(hWindow, 1);
  615.     TDlgWindow.WMDestroy(msg);
  616.   END;
  617.  
  618.   PROCEDURE TThisApp.InitMainWindow;
  619.   begin
  620.     mainWindow := NEW(PThisWindow, Init);
  621.   end;
  622.  
  623. BEGIN
  624.   {$G-}
  625.   IF (GetWinFlags AND (wf_CPU086 OR wf_CPU186)) <> 0 THEN BEGIN
  626.     MessageBox(0, 'WinHelp needs a 286 or better', NIL, mb_OK);
  627.     HALT(0);
  628.   END;
  629.   {$G+}
  630.   thisApp.Init(appName);
  631.   thisApp.Run;
  632.   thisApp.Done;
  633. END.
  634.